home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / FILEMNU2.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  11KB  |  330 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  7-23-88 5:13 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit FileMnu2;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Dos, Globals, TAccess, Core1,
  19.   Core2, TPSTRING, TPDOS, Exdate;
  20.   
  21.   
  22. procedure files_list;
  23.  
  24. procedure newin_list(mode : Char);
  25.  
  26.  
  27.   {==========================================================================}
  28.   
  29.   
  30. Implementation
  31.  
  32.  
  33.   procedure files_list;
  34.     { List files in current section }
  35.     
  36.   var
  37.     line_count,
  38.     not_found       : Integer;
  39.     Str             : string;
  40.     i               : LongInt;
  41.     SectionStr      : DosFileName;
  42.     Dirspec         : StrPr;
  43.     TmpDrv          : Str3;
  44.     key, SearchKey,
  45.     fname           : DosFileName;
  46.     still_in_newin  : Boolean;
  47.     
  48.     
  49.     procedure display_record;
  50.     
  51.     begin
  52.       with nwin_rec do
  53.         begin
  54.           WriteLn(Com);
  55.           not_found := 0;
  56.           Str := yellow+hi+pad(name, 15)+white+intstr(date[4], 2)+'/'+
  57.           intstr(date[3], 2)+'/'+intstr(date[5], 2)+yellow;
  58.           Write(Com, Str);
  59.           if CreditType = Points then
  60.             WriteLn(Com, '    Cost: ', PointValue, ' Points')
  61.           else
  62.             WriteLn(Com, '    Downloads: ', dnloads);
  63.           WriteLn(Com, cyan, '    ', descr);
  64.           if (user_rec.lines <> 99) then
  65.             begin
  66.               Inc(line_count);
  67.               if line_count mod (user_rec.lines div 3) = 0 then
  68.                 pause;
  69.             end;
  70.         end;
  71.     end;
  72.     
  73.     
  74.   begin
  75.     abort := False;
  76.     line_count := 0;
  77.     fname := '';
  78.     WriteLn(Com);
  79.     if ask('Search for file(s)', 'N') then
  80.       begin
  81.         fname := prompt('Filename (partial name OK) >', 12, 'ES');
  82.         if Pos('*', fname) <> 0 then
  83.           begin
  84.             Delete(fname, Pos('*', fname), 12);
  85.             WriteLn(Com, 'Use partial names, not wildcards.');
  86.           end;
  87.       end;
  88.     if SectReq = 'NEWIN' then
  89.       begin
  90.         SectionStr := 'NEWIN';
  91.         FindSect(SectionStr, TmpDrv, OK);
  92.         Dirspec := TmpDrv;
  93.         if (Length(HomName) > 3) and (Dirspec = HomDrv) then
  94.           begin
  95.             Dirspec := Dirspec+Copy(HomName, 4, Length(HomName));
  96.             Dirspec := Dirspec+'\'
  97.           end;
  98.         Dirspec := Dirspec+'NEWIN';
  99.         not_found := 0;
  100.         i := Pred(FileSize(nwin_file));
  101.         while (not brk) and (i >= 1) do
  102.           begin
  103.             Seek(nwin_file, i);
  104.             Read(nwin_file, nwin_rec);
  105.             with nwin_rec do
  106.               begin
  107.                 still_in_newin := ExistFile(Dirspec+'\'+name);
  108.                 if (status = public) and (still_in_newin) and
  109.                 ((fname = ' ') or (Pos(fname, name) = 1)) then
  110.                   display_record
  111.                 else
  112.                   begin
  113.                     if (not still_in_newin) then
  114.                       Inc(not_found);
  115.                     if not_found > 50 then
  116.                       i := 1;
  117.                   end;
  118.               end;
  119.             i := Pred(i);
  120.           end;
  121.         if FileSize(nwin_file) = 0 then
  122.           begin
  123.             WriteLn(Com);
  124.             WriteLn(Com, 'Newin List is empty.');
  125.             WriteLn(Com);
  126.           end;
  127.       end
  128.     else
  129.       begin
  130.         SearchKey := SectReq;
  131.         key := SectReq;
  132.         FindKey(NewinArea, i, key);
  133.         if OK then
  134.           begin
  135.             repeat
  136.               Seek(nwin_file, i);
  137.               Read(nwin_file, nwin_rec);
  138.               SetSect(SetName);
  139.               if (nwin_rec.status = public) and ExistFile(nwin_rec.name)
  140.               and ((fname = ' ') or (Pos(fname, nwin_rec.name) = 1)) then
  141.                 display_record;
  142.               SetSect(HomName);
  143.               NextKey(NewinArea, i, key);
  144.             until (not OK) or (key <> SearchKey) or brk;
  145.             Write(Com, cyan);
  146.           end
  147.         else
  148.           begin
  149.             WriteLn(Com);
  150.             WriteLn(Com, 'No files listed for this section.');
  151.             WriteLn(Com);
  152.           end;
  153.       end;
  154.   end;
  155.   
  156.   
  157.   procedure newin_list(mode : Char);
  158.     { List new uploads }
  159.     
  160.   var
  161.     i               : LongInt;
  162.     line_count,
  163.     conf_num,
  164.     new_days,
  165.     past_new_days   : Integer;
  166.     Str             : StrTAD;
  167.     temp_user_rec   : user_list;
  168.     This            : SectPtr;
  169.     none_found      : Boolean;
  170.     fname,   
  171.     SectionStr,
  172.     key             : DosFileName;
  173.     Dirspec         : StrPr;
  174.     TmpDrv          : Str3;
  175.     lines           : Byte;
  176.     
  177.   begin
  178.     fname := '';
  179.     abort := False;
  180.     SectionStr := 'NEWIN';
  181.     FindSect(SectionStr, TmpDrv, OK);
  182.     Dirspec := TmpDrv;
  183.     if (Length(HomName) > 3) and (Dirspec = HomDrv) then
  184.       begin
  185.         Dirspec := Dirspec+Copy(HomName, 4, Length(HomName));
  186.         Dirspec := Dirspec+'\'
  187.       end;
  188.     Dirspec := Dirspec+'NEWIN';
  189.     none_found := True;
  190.     past_new_days := 0;
  191.     i := Pred(FileSize(nwin_file));
  192.     WriteLn(Com);
  193.     if mode = 'N' then
  194.       begin
  195.         Str := prompt('Days previous to check [CR = since last on] ', 4, 'EL');
  196.         if Str <> '' then
  197.           new_days := strint(Str)
  198.         else
  199.           new_days := Succ(day_diff(user_rec.laston[3], user_rec.laston[4],
  200.             user_rec.laston[5]+1900, login_t[3], login_t[4], login_t[5]+1900));
  201.       end
  202.     else
  203.       begin
  204.         new_days := MaxInt;
  205.         fname := prompt('Filename (partial name OK) ', 12, 'ES');
  206.         if fname <> ' ' then
  207.           begin
  208.             if Pos('*', fname) <> 0 then
  209.               begin
  210.                 Delete(fname, Pos('*', fname), 12);
  211.                 WriteLn(Com, 'Use partial names, not wildcards.');
  212.               end;
  213.             WriteLn(Com);
  214.             key := fname;
  215.             SearchKey(NewinName, i, key);
  216.             if (Pos(fname, key) <> 1) or (not OK) then
  217.               i := -1;
  218.           end
  219.         else
  220.           i := -1;
  221.       end;
  222.     line_count := 0;
  223.     OK := True;
  224.     while (not brk) and (i >= 1) and (past_new_days < 20) do
  225.       begin
  226.         check_time;
  227.         Seek(nwin_file, i);
  228.         Read(nwin_file, nwin_rec);
  229.         This := SectBase;
  230.         with nwin_rec do
  231.           begin
  232.             if status = public then
  233.               begin
  234.                 while (This <> nil) and (This^.SectName <> sectn) do
  235.                   This := This^.next;
  236.                 conf_num := This^.SectConf;
  237.                 if (user_rec.access >= This^.SectAccs) or (test_bit(user_rec.conf_flags,
  238.                   conf_num)) then
  239.                   begin
  240.                     OK := (day_diff(date[3], date[4], date[5]+1900, login_t[3],
  241.                       login_t[4], login_t[5]+1900) < new_days);
  242.                     if OK then
  243.                       past_new_days := 0
  244.                     else
  245.                       Inc(past_new_days);
  246.                     if OK then
  247.                       begin
  248.                         timer(time_on, time_left);
  249.                         none_found := False;
  250.                         Str := intstr(date[4], 2)+'/'+intstr(date[3], 2)+'/'+intstr(date
  251.                           [5], 2);
  252.                         if (user > 0) and (user <= FileLen(DatF)) then
  253.                           begin
  254.                             GetRec(DatF, user, temp_user_rec);
  255.                             if temp_user_rec.used <> 0 then
  256.                               begin
  257.                                 temp_user_rec.fn := '';
  258.                                 temp_user_rec.ln := '';
  259.                               end;
  260.                           end
  261.                         else
  262.                           begin
  263.                             temp_user_rec.fn := 'Unknown';
  264.                             temp_user_rec.ln := 'Sender';
  265.                           end;
  266.                         if (mode = 'N') then
  267.                           WriteLn(Com);
  268.                         if ExistFile(Dirspec+'\'+name) then
  269.                           SectionStr := 'NEWIN'
  270.                         else
  271.                           SectionStr := sectn;
  272.                         if mode = 'N' then
  273.                           begin
  274.                             Write(Com, hi, yellow, pad(name, 15), SectionStr,
  275.                               ' Section ', Str, '  ');
  276.                             WriteLn(Com, temp_user_rec.fn, ' ',
  277.                               temp_user_rec.ln);
  278.                             Str := intstr(last_dnload[4], 2)+'/'+
  279.                             intstr(last_dnload[3], 2)+'/'+intstr(last_dnload[5], 2);
  280.                             Write(Com, white, 'Downloads ', dnloads, '  Last download ',
  281.                               Str, cyan);
  282.                             if CreditType = Points then
  283.                               Write(Com, '   Points ', PointValue);
  284.                             WriteLn(Com);
  285.                             WriteLn(Com, '    ', descr);
  286.                           end
  287.                         else
  288.                           WriteLn(Com, yellow, pad(name, 15), green, ' Location: ',
  289.                             yellow, SectionStr, cyan);
  290.                         if (user_rec.lines <> 99) then
  291.                           begin
  292.                             Inc(line_count);
  293.                             if mode = 'N' then
  294.                               lines := 4
  295.                             else
  296.                               lines := 1;
  297.                             if line_count mod (user_rec.lines div lines) = 0 then
  298.                               pause;
  299.                           end;
  300.                       end;        {fname='' or equal names}
  301.                   end;            {print out}
  302.               end;
  303.           end;
  304.         if fname = '' then
  305.           Dec(i)
  306.         else
  307.           begin
  308.             NextKey(NewinName, i, key);
  309.             if (Pos(fname, key) = 0) or (not OK) then
  310.               i := -1;
  311.           end;
  312.       end;
  313.     if (none_found) and (FileSize(nwin_file) > 1) then
  314.       begin
  315.         WriteLn(Com);
  316.         WriteLn(Com, 'No file(s) found.');
  317.         WriteLn(Com);
  318.       end;
  319.     if FileSize(nwin_file) = 1 then
  320.       begin
  321.         WriteLn(Com);
  322.         WriteLn(Com, 'Newin List is empty.');
  323.         WriteLn(Com);
  324.       end;
  325.   end;
  326.   
  327.   
  328. end.                              { of FILEMNU2.PAS }
  329. 
  330.